home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-eif.el < prev    next >
Encoding:
Text File  |  1995-05-20  |  9.9 KB  |  275 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-eif.el
  4. ;; SUMMARY:      Support routines for Eiffel inheritance browsing and error parsing.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:     7-Dec-89
  12. ;; LAST-MOD:     19-May-95 at 14:49:31 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1989-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Other required Elisp libraries
  24. ;;; ************************************************************************
  25.  
  26. (require 'br-lib)
  27.  
  28. ;;; ************************************************************************
  29. ;;; User visible variables
  30. ;;; ************************************************************************
  31.  
  32. (defvar eif-lib-search-dirs nil
  33.   "List of directories below which Eiffel Library source files are found.
  34. Subdirectories of Library source are also searched.  A Library is a stable
  35. group of classes.")
  36.  
  37. (defvar eif-sys-search-dirs nil
  38.   "List of directories below which Eiffel System source files are found.
  39. Subdirectories of System source are also searched.  A System class is one
  40. that is not yet reusable and is likely to change before release.")
  41.  
  42. (defconst eif-narrow-view-to-class nil
  43.  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  44.  
  45. ;;; ************************************************************************
  46. ;;; Internal functions
  47. ;;; ************************************************************************
  48.  
  49. (defun eif-get-classes-from-source (filename &optional skip-tags
  50.                     skip-tags-cleanup)
  51.   "Scans FILENAME and returns cons of class list with parents-class alist.
  52. Handles multiple inheritance.  Assumes file existence and readability have
  53. already been checked.
  54.    With optional SKIP-TAGS non-nil, does not compute and store lookup tags
  55. for element definitions.  If SKIP-TAGS is nil, normally a cleanup
  56. function is called after scanning the elements.  SKIP-TAGS-CLEANUP
  57. non-nil suppresses this action."
  58.   ;; Multiple classes per file allowed
  59.   (let ((no-kill (get-file-buffer filename))
  60.     classes class end parents signatures start)
  61.     (if no-kill
  62.     (set-buffer no-kill)
  63.       (funcall br-view-file-function filename))
  64.     (save-excursion
  65.       (save-restriction
  66.     (widen)
  67.     (goto-char (point-min))
  68.     (while (re-search-forward eif-class-def-regexp nil t)
  69.       (setq start (point)
  70.         class
  71.         (eif-set-case
  72.          (buffer-substring (match-beginning 2) (match-end 2)))
  73.         classes (cons class classes)
  74.         parents (cons (cons (eif-get-parents-from-source
  75.                      filename class)
  76.                     class)
  77.                   parents))
  78.       (eif-to-class-end)
  79.       (setq end (point))
  80.       (or skip-tags
  81.           ;; Scan class features
  82.           (setq signatures
  83.             (eif-scan-features-in-class class start end))))))
  84.     (if skip-tags
  85.     nil
  86.       (eif-get-feature-tags
  87.        buffer-file-name (eif-sort-features signatures))
  88.       (or skip-tags-cleanup (br-feature-tags-save)))
  89.     (or no-kill (kill-buffer (current-buffer)))
  90.     (cons classes (delq nil parents))))
  91.  
  92. (defun eif-get-parents-from-source (filename &optional class-name)
  93.   "Return list of downcased parents of Eiffel class in FILENAME.
  94. Return nil if file is not readable.  Assume that Eiffel keywords
  95. 'inherit' and 'feature' occur at the beginning of lines, when present."
  96.   (let ((parents) (par)
  97.     (no-kill (get-file-buffer filename))
  98.     (obuf (current-buffer)))
  99.     (if no-kill
  100.     (set-buffer no-kill))
  101.     (if (or no-kill
  102.         (and (file-readable-p filename)
  103.          (let ((br-view-file-function 'br-insert-file-contents))
  104.            (message "Scanning %s ..." filename)
  105.            (funcall br-view-file-function filename)
  106.            t)))
  107.     (progn
  108.       (save-restriction
  109.         (save-excursion
  110.           (widen)
  111.           (goto-char (point-min))
  112.           (let ((case-fold-search t) ;; Ignore case in searches
  113.             (end)
  114.             indent)
  115.         (if (or (null class-name)
  116.             (let ((class-def (concat eif-class-name-before 
  117.                          (eif-set-case-type class-name)
  118.                          eif-class-name-after)))
  119.               (re-search-forward class-def nil t)))
  120.             (if (not (re-search-forward (concat "^inherit[ \t\n]+"
  121.                             eif-parent-regexp)
  122.                         nil t))
  123.             nil
  124.               ;; Save first parent
  125.               (setq parents (list
  126.                      (eif-set-case (buffer-substring
  127.                             (match-beginning 2)
  128.                             (match-end 2))))
  129.                 indent (save-excursion
  130.                      (goto-char (match-beginning 2))
  131.                      (current-column)))
  132.               ;; Save any succeeding parents
  133.               (save-excursion
  134.             (if (re-search-forward "^[a-zA-Z]" nil t)
  135.                 (setq end (1- (point)))))
  136.               (forward-line 1)
  137.                (while (< (point) end)
  138.             (back-to-indentation)
  139.             (and (<= (current-column) indent)
  140.                  (looking-at eif-identifier)
  141.                  (setq par (eif-set-case (buffer-substring
  142.                               (match-beginning 1)
  143.                               (match-end 1))))
  144.                  (if (or (br-member par parents)
  145.                      (br-member-sorted-strings
  146.                       par eif-reserved-words))
  147.                  nil
  148.                    (setq parents (cons par parents))))
  149.             (forward-line 1)))))))
  150.       (or no-kill (kill-buffer (current-buffer)))
  151.       (set-buffer obuf)
  152.       (nreverse parents)))))
  153.  
  154. (defun eif-select-path (paths-htable-elt &optional feature-p)
  155.   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
  156. Selection is between path of class definition and path for features associated
  157. with the class."
  158.   (cdr paths-htable-elt))
  159.  
  160. (defun eif-set-case (type)
  161.   "Return string TYPE identifier for use as a class name."
  162.   (downcase type))
  163.  
  164. (defun eif-set-case-type (class-name)
  165.   "Return string CLASS-NAME for use as a type identifier."
  166.   (upcase class-name))
  167.  
  168.  
  169. (defun eif-to-class-end ()
  170.   "Assuming point is at start of class, move to start of line after end of class."
  171.   (interactive)
  172.   (if (and (re-search-forward "^end[ \t\n-]" nil t)
  173.        (= (forward-line 1) 0))
  174.       nil
  175.     (goto-char (point-max))))
  176.  
  177. (defun eif-to-comments-begin ()
  178.   "Skip back from current point past any preceding blank lines and comments."
  179.   (let ((opoint))
  180.     (while
  181.     (progn (setq opoint (point))
  182.            ;; To previous line
  183.            (and (= 0 (forward-line -1))
  184.             ;; If begins with "--", then is a comment.
  185.             (cond ((looking-at "[ \t]*--"))
  186.               ((looking-at "[ \t]*$"))))))
  187.     (goto-char opoint)
  188.     ;; Skip past whitespace
  189.     (skip-chars-forward " \t\n")
  190.     (beginning-of-line)))
  191.  
  192. ;;; ************************************************************************
  193. ;;; Internal variables
  194. ;;; ************************************************************************
  195.  
  196. (defconst eif-class-name-before "^[ \t]*\\(deferred[ \t\n]+\\|expanded[ \t\n]+\\)?class[ \t\n]+"
  197.   "Regexp preceding the class name in a class definition.")
  198.  
  199. (defconst eif-class-name-after "[ \t\n]+"
  200.   "Regexp following the class name in a class definition.")
  201.  
  202. (defconst eif-identifier-chars "A-Za-z0-9_"
  203.   "String of chars and char ranges that may be used within an Eiffel identifier.")
  204.  
  205. (defconst eif-identifier (concat "\\([a-zA-Z][" eif-identifier-chars "]*\\)")
  206.   "Regular expression matching an Eiffel identifier.")
  207.  
  208. (defconst eif-class-def-regexp
  209.   (concat eif-class-name-before eif-identifier eif-class-name-after)
  210.   "Regular expression used to match to class definitions in source text.
  211. Class name identifier is grouped expression 2.")
  212.  
  213. (defconst eif-class-name-preceding
  214.   "\\([\[\{>;:][ \t\n]*\\|[a-zA-z][ \t\n]+\\)"
  215.   "Pattern preceding any valid non-comment use of an Eiffel class/type name.")
  216.  
  217. (defconst eif-class-name-pat
  218.   (concat eif-class-name-preceding eif-identifier)
  219.   "Class name is grouped expression 2.")
  220.  
  221. (defconst eif-lang-prefix "eif-"
  222.   "Prefix string that starts \"br-eif.el\" symbol names.")
  223.  
  224.  
  225. (defconst eif-parent-regexp (concat "[ \t\n]*\\(--.*[\n]\\)*[ \t\n]*"
  226.                     eif-identifier)
  227.   "Parent identifier is grouped expression 2.")
  228.  
  229. (defconst eif-file-dir-regexp "^[^.~#].*[^.~#]$"
  230.   "Regexp that ignores extraneous, non-source files and directories.")
  231.  
  232. (defconst eif-src-file-regexp ".\\.e$"
  233.   "Regular expression matching a unique part of Eiffel class filenames and no others.")
  234.  
  235. (defvar eif-children-htable nil
  236.   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
  237. Used to traverse Eiffel inheritance graph.  'br-build-children-htable' builds
  238. this list.")
  239. (defvar eif-parents-htable nil
  240.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  241. Used to traverse Eiffel inheritance graph.  'br-build-parents-htable' builds
  242. this list.")
  243. (defvar eif-paths-htable nil
  244.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
  245. DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
  246. 'br-build-paths-htable' builds this list.")
  247.  
  248. (defvar eif-lib-parents-htable nil
  249.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  250. Only classes from stable software libraries are used to build the list.")
  251. (defvar eif-lib-paths-htable nil
  252.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
  253. DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
  254. Only classes from stable software libraries are used to build the list.")
  255.  
  256. (defvar eif-sys-parents-htable nil
  257.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  258. Only classes from systems that are likely to change are used to build the list.")
  259. (defvar eif-sys-paths-htable nil
  260.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
  261. DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
  262. Only classes from systems that are likely to change are used to build the
  263. list.")
  264.  
  265. (defvar eif-lib-prev-search-dirs nil
  266.   "Used to check if 'eif-lib-paths-htable' must be regenerated.")
  267. (defvar eif-sys-prev-search-dirs nil
  268.   "Used to check if 'eif-sys-paths-htable' must be regenerated.")
  269.  
  270. (defvar eif-env-spec nil
  271.   "Non-nil value means Environment specification has been given but not yet built.
  272. Nil means current Environment has been built, though it may still require updating.")
  273.  
  274. (provide 'br-eif)
  275.